---
title: "Tracking COVID cases in Scotland (last updated: `r format(Sys.Date(), '%d %B %Y')`)"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
source_code: embed # Adds the source code as a popup
---
```{r preparation, include=FALSE}
# Load the required libraries
library(flexdashboard) # Building the dashboard
library(leaflet) # Interactive mapping
library(plotly) # Interactive plots
library(rgdal) # Reading in shape files
library(rgeos) # Used for transfomring from UK grid to lat-longs - required for leaflet
# Set the path
path <- file.path("~", "Desktop", "COVID-19")
```
```{r functions, echo=FALSE}
## FUNCTIONS
# Function to get the latest case count for each region/country in case count table
getLatestCaseCountForEachRegion <- function(cases, columns){
# Get the latest counts and ignore NAs
nCases <- sapply(columns,
FUN=function(column, cases){
values <- cases[, column]
values <- values[is.na(values) == FALSE]
return(values[length(values)])
}, cases)
return(as.numeric(nCases))
}
# Function to get the date when each region surpassed tthreshold number of cases
buildTableForTimeSinceCasesReachedThreshold <- function(cases, threshold){
# Get the latest date
latestDate <- cases[nrow(cases), "Date"]
# Get the row index when each region reached threshold
indices <- sapply(2:(ncol(cases)-2),
function(column, threshold, cases){
return(which(cases[, column] >= threshold)[1])
},
threshold, cases)
# Initialise a table to store the number of cases each day after reached threshold
maxNumberOfDays <- latestDate - cases[min(indices, na.rm=TRUE), "Date"]
daysSince <- data.frame("NumberDaysSince"=1:maxNumberOfDays)
# Get the names of the regions
regions <- colnames(cases)[-c(1, ncol(cases), ncol(cases)-1)]
# Add data for each region within Scotland
for(column in 2:(ncol(cases)-2)){
# Add a column for the current region
daysSince[, regions[column-1]] <- NA
# Skip regions that never reached threshold
if(is.na(indices[column-1])){
next
}
# Store the data for the current region
values <- cases[indices[column-1]:nrow(cases), regions[column-1]]
daysSince[1:length(values), regions[column-1]] <- values
}
return(daysSince)
}
# Function to calculate the number of new cases each day
calculateNewCasesPerDay <- function(cases){
# Initialise a vector to store the number of new cases on each day
newCases <- c(cases[1, "Grand Total"])
# Examine the number of confirmed cases on each
for(row in 2:nrow(cases)){
# Calculate the number of new cases for current day (today's total minus yesterday's)
newCases[row] <- cases[row, "Grand Total"] - cases[row-1, "Grand Total"]
}
return(newCases)
}
# Function to parse scottish case count data
getCaseCountsForScotland <- function(fileURL){
# Load the regional confirmed cases counts for Scotland
scotlandCases <- read.csv(fileURL, stringsAsFactors=FALSE, check.names=FALSE)
# Format the date column fo the cases table
scotlandCases$Date <- as.Date(scotlandCases$Date, format="%d-%b-%Y")
# Calculate the number of new cases per day
scotlandCases$NewCases <- calculateNewCasesPerDay(scotlandCases)
return(scotlandCases)
}
# Function to plot number of cases per region of shape file
chloropleth <- function(boundaries, nameCol, nCases, centre, zoom=6){
# Create a colour palette
qpal <- colorBin("Reds", nCases, bins=5)
# Create labels that will appear on hover
labels <- paste0("", boundaries@data[, nameCol], "
", nCases, " cases") %>% lapply(htmltools::HTML)
# Create an initial map
leaflet(boundaries) %>%
# Set the starting view
setView(lng=centre[1], lat=centre[2], zoom = 6) %>%
# Add polygons for the each region
addPolygons(weight=2, fillColor=~qpal(nCases), color="white", dashArray = "3",
highlight = highlightOptions(
weight=5,
color="#666",
dashArray="",
fillOpacity=0.95,
bringToFront=TRUE),
label=labels,
labelOptions = labelOptions(
style=list("font-weight" = "normal", padding = "3px 8px"),
textsize="15px",
direction="auto")) %>%
# Add a legend
addLegend(values=nCases, pal=qpal, title="Number confirmed cases")
}
# Function to plot the number of confirmed cases and new cases through time
plotTotalCasesThroughTime <- function(cases){
# Initialise a figure
fig <- plot_ly(cases, x=cases$Date)
# Add a trace for the confirmed cases
fig <- add_trace(fig, y=cases$`Grand Total`, name="Cumulative total", mode="lines+markers",
hovertemplate=paste0(format(cases$Date, "%b %d"), ": ", cases$`Grand Total`))
# Add bars for the number of new cases
fig <- add_bars(fig, y=cases$NewCases, name="New cases",
hovertemplate=paste0(format(cases$Date, "%b %d"), ": ", cases$NewCases))
# Add legend within plot and remove background colour
fig <- layout(fig, legend=list(x=0.1, y=0.9, bgcolor = rgb(0,0,0,0)))
# Plot the figure
fig
}
# Function to plot the number of confirmed cases for each region through time
plotTotalCasesThroughTimeForEachRegion <- function(daysSince, logYAxis=FALSE){
# Initialise a figure
fig <- plot_ly(daysSince, x=daysSince$NumberDaysSince)
# Add a trace for each region
for(column in colnames(daysSince)[-1]){
fig <- add_trace(fig, y=daysSince[, column], name=column, mode="lines+markers",
hovertemplate=paste0(daysSince$NumberDaysSince, " days since: ", daysSince[, column]))
}
# Add an X axis label
fig <- layout(fig, xaxis=list(title=paste0("Number of days since ", threshold, " cases")))
# Log the Y-axis - if requested
if(logYAxis){
fig <- layout(fig, yaxis = list(type="log"))
}
# Set the Y axis limits
fig <- layout(fig, yaxis=list(range=c(0, max(daysSince[, -1], na.rm=TRUE)), title="Number of confirmed cases"))
# Add lines to show doubling every 2 days
values <- c(threshold, threshold * exp(log(2) / 2) ^ (1:(nrow(daysSince)-1)))
fig <- add_trace(fig, y=values, name="Doubling every 2 days", mode="lines", line=list(dash="dash", color=rgb(0,0,0, 0.5)),
hovertemplate=paste0(daysSince$NumberDaysSince, " days since: ", round(values, digits=0)),
showlegend = FALSE)
# Add lines to show doubling every 3 days
values <- c(threshold, threshold * 1.260 ^ (1:(nrow(daysSince)-1)))
fig <- add_trace(fig, y=values, name="Doubling every 3 days", mode="lines", line=list(dash="dash", color=rgb(0,0,0, 0.5)),
hovertemplate=paste0(daysSince$NumberDaysSince, " days since: ", round(values, digits=0)),
showlegend = FALSE)
# Add lines to show doubling every 7 days
values <- c(threshold, threshold * 1.104 ^ (1:(nrow(daysSince)-1)))
fig <- add_trace(fig, y=values, name="Doubling every 7 days", mode="lines", line=list(dash="dash", color=rgb(0,0,0, 0.5)),
hovertemplate=paste0(daysSince$NumberDaysSince, " days since: ", round(values, digits=0)),
showlegend = FALSE)
# Add legend within plot and remove background colour
fig <- layout(fig, legend=list(x=0.1, y=1, bgcolor = rgb(0,0,0,0)))
# Plot the figure
fig
}
# Function to read in and simplify shape file
readInBoundariesAndSimplify <- function(shapeFile){
# Read in the shape file
boundaries <- rgdal::readOGR(shapeFile)
# Convert to latitude and longitude
boundaries <- spTransform(boundaries, CRS("+datum=WGS84 +proj=longlat"))
# Simplify the shape file
simplerPolygons <- gSimplify(boundaries, tol=0.05, topologyPreserve=FALSE)
boundaries <- SpatialPolygonsDataFrame(simplerPolygons, boundaries@data)
return(boundaries)
}
readInUKCountryData <- function(scotlandFile, englandFile, walesFile, northernIrelandFile, ukFile){
# Read in the files for each country
scotland <- read.csv(scotlandFile, stringsAsFactors=FALSE, check.names=FALSE,
col.names=c("Date", "Tests_Scotland", "ConfirmedCases_Scotland", "Deaths_Scotland"))
england <- read.csv(englandFile, stringsAsFactors=FALSE, check.names=FALSE,
col.names=c("Date", "Tests_England", "ConfirmedCases_England", "Deaths_England"))
wales <- read.csv(walesFile, stringsAsFactors=FALSE, check.names=FALSE,
col.names=c("Date", "Tests_Wales", "ConfirmedCases_Wales", "Deaths_Wales"))
northernIreland <- read.csv(northernIrelandFile, stringsAsFactors=FALSE, check.names=FALSE,
col.names=c("Date", "Tests_NI", "ConfirmedCases_NI", "Deaths_NI"))
uk <- read.csv(ukFile, stringsAsFactors=FALSE, check.names=FALSE,
col.names=c("Date", "Tests_UK", "ConfirmedCases_UK", "Deaths_UK"))
# Combine the tables by date
ukCases <- merge(scotland, england, by="Date", all=TRUE)
ukCases <- merge(ukCases, wales, by="Date", all=TRUE)
ukCases <- merge(ukCases, northernIreland, by="Date", all=TRUE)
ukCases <- merge(ukCases, uk, by="Date", all=TRUE)
return(ukCases)
}
```
Scotland
=====================================
```{r loading case counts for scotland, echo=FALSE}
## Loading the data
# Load the regional confirmed cases counts for Scotland
regionalCasesFile <- "https://raw.githubusercontent.com/watty62/Scot_covid19/master/data/processed/regional_cases.csv"
scotlandCases <- getCaseCountsForScotland(regionalCasesFile)
```
```{r calculate time since X cases for each region in scotland, echo=FALSE}
## Align region cases by time since X cases
# Set X (threshold number of cases)
threshold <- 10
# Get the number of cases for each region once passed threshold
daysSince <- buildTableForTimeSinceCasesReachedThreshold(scotlandCases, threshold)
```
```{r read shape file with health departments in scotland, include=FALSE}
## Read in the joined Health Boards
# Read in the shape file
shapeFile <- file.path(path, "SG_NHS_HealthBoards_2019", "SG_NHS_HealthBoards_2019.shp")
scotland <- readInBoundariesAndSimplify(shapeFile)
```
Column {data-width=55%}
-----------------------------------------------------------------------
### Regional patterns of confirmed cases as of `r format(scotlandCases[nrow(scotlandCases), "Date"], "%d %B %Y")`
```{r chloropleth of new cases in each region in scotland, echo=FALSE}
# Get the latest number of confirmed cases for each region in Scotland
nCases <- getLatestCaseCountForEachRegion(scotlandCases, as.character(scotland$HBName))
# Plot a leaflet chloropleth illustrating number of cases in each region
chloropleth(boundaries=scotland, nameCol="HBName", nCases=nCases, centre=c(-4.6873411, 57.7469948))
```
### Data sources {data-height=30%}
These visualisations are based on non-official numbers and therefore shouldn't inform official decision making. These COVID-19 data were sourced directly from [here](https://github.com/watty62/Scot_covid19/blob/master/data/processed/regional_cases.csv). The geographical shape file was sourced from [here](https://data.gov.uk/dataset/27d0fe5f-79bb-4116-aec9-a8e565ff756a/nhs-health-boards). This dashboard was informed by the following existing [dashboard](https://smazeri.shinyapps.io/Covid19_Scotland/#section-cases).
Column {data-width=45%}
-----------------------------------------------------------------------
### COVID-19 confirmed cases in Scotland as of `r format(scotlandCases[nrow(scotlandCases), "Date"], "%d %B %Y")`
```{r summary values for total and new cases in scotland, echo=FALSE}
valueBox(paste0(scotlandCases[nrow(scotlandCases), "Grand Total"], " cases ",
" (", scotlandCases[nrow(scotlandCases), "NewCases"], " new)"))
```
### Number of confirmed cases through time as of `r format(scotlandCases[nrow(scotlandCases), "Date"], "%d %B %Y")`
```{r plot of cumulative number of cases for scotland, echo=FALSE}
# Plotting confirmed cases through time
plotTotalCasesThroughTime(scotlandCases)
```
### Number of confirmed cases since reaching `r threshold` cases by region as of `r format(scotlandCases[nrow(scotlandCases), "Date"], "%d %B %Y")`
```{r plotting cumulative case trends since reaching threshold for each region in scotland, echo=FALSE}
# Plotting the confirmed cases through time for each region
plotTotalCasesThroughTimeForEachRegion(daysSince)
```
United Kingdom
=====================================
```{r loading case counts for uk, include=FALSE}
## Loading the data
# Note the file names
englandFile <- "https://raw.githubusercontent.com/tomwhite/covid-19-uk-data/master/data/covid-19-totals-england.csv"
scotlandFile <- "https://raw.githubusercontent.com/tomwhite/covid-19-uk-data/master/data/covid-19-totals-scotland.csv"
northernIrelandFile <- "https://raw.githubusercontent.com/tomwhite/covid-19-uk-data/master/data/covid-19-totals-northern-ireland.csv"
walesFile <- "https://raw.githubusercontent.com/tomwhite/covid-19-uk-data/master/data/covid-19-totals-wales.csv"
ukFile <- "https://raw.githubusercontent.com/tomwhite/covid-19-uk-data/master/data/covid-19-totals-uk.csv"
# Read in the UK data
ukCases <- readInUKCountryData(scotlandFile, englandFile, walesFile, northernIrelandFile, ukFile)
# Select the confirmed cases counts
ukCases <- ukCases[, colnames(ukCases) %in% c("Date", "ConfirmedCases_Scotland", "ConfirmedCases_England",
"ConfirmedCases_Wales", "ConfirmedCases_NI",
"ConfirmedCases_UK")]
colnames(ukCases) <- c("Date", "Scotland", "England", "Wales", "Northern Ireland", "Grand Total")
# Calculate the number of new cases per day
ukCases$NewCases <- calculateNewCasesPerDay(ukCases)
# Remove empty rows
start <- which(rowSums(ukCases[2:7], na.rm=TRUE) != 0)[1]
ukCases <- ukCases[start:nrow(ukCases), ]
# Convert the dates column back to dates
ukCases$Date <- as.Date(ukCases$Date)
```
```{r calculate time since X cases for uk, echo=FALSE}
## Align region cases by time since X cases
# Set the threshold
threshold <- 50
# Get the number of cases for each region once passed threshold
daysSince <- buildTableForTimeSinceCasesReachedThreshold(ukCases, threshold)
```
```{r read shape file for countries in uk, include=FALSE}
# Read in the UK shape file
shapeFile <- file.path(path, "Countries_December_2019_Boundaries_UK_BFE",
"Countries_December_2019_Boundaries_UK_BFE.shp")
uk <- readInBoundariesAndSimplify(shapeFile)
```
Column {data-width=55%}
-----------------------------------------------------------------------
### Regional patterns of confirmed cases as of `r format(ukCases[nrow(ukCases), "Date"], "%d %B %Y")`
```{r chloropleth of new cases in each country, echo=FALSE}
# Get the latest number of confirmed cases for each country in UK
nCases <- getLatestCaseCountForEachRegion(ukCases, as.character(uk$ctry19nm))
# Plot a leaflet chloropleth illustrating number of cases in each country
chloropleth(boundaries=uk, nameCol="ctry19nm", nCases=nCases, centre=c(-2.7181907, 54.921807))
```
### Data sources {data-height=30%}
These visualisations are based on non-official numbers and therefore shouldn't inform official decision making. These COVID-19 data were sourced directly from [here](https://github.com/tomwhite/covid-19-uk-data/blob/master/data/covid-19-cases-uk.csv). The geographical shape file was sourced from [here](https://geoportal.statistics.gov.uk/datasets/countries-december-2019-boundaries-uk-bfe). This dashboard was informed by the following existing [dashboard](https://smazeri.shinyapps.io/Covid19_Scotland/#section-cases).
Column {data-width=45%}
-----------------------------------------------------------------------
### COVID-19 confirmed cases in United Kingdom as of `r format(ukCases[nrow(ukCases), "Date"], "%d %B %Y")`
```{r summary values for total and new cases in uk, echo=FALSE}
# Get latest total and new cases count
lastRecorded <- which(is.na(ukCases$`Grand Total`) == FALSE)
lastRecorded <- lastRecorded[length(lastRecorded)]
valueBox(paste0(ukCases[lastRecorded, "Grand Total"], " cases ",
" (", ukCases[lastRecorded, "NewCases"], " new)"))
```
### Number of confirmed cases through time as of `r format(ukCases[nrow(ukCases), "Date"], "%d %B %Y")`
```{r plot of cumulative number of cases in uk, echo=FALSE}
# Plotting confirmed cases through time
plotTotalCasesThroughTime(ukCases)
```
### Number of confirmed cases since reaching `r threshold` cases by region as of `r format(ukCases[nrow(ukCases), "Date"], "%d %B %Y")`
```{r plotting cumulative case trends since reaching threshold in each country, echo=FALSE}
# Plotting the confirmed cases through time for each country
plotTotalCasesThroughTimeForEachRegion(daysSince)
```